home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / lib / extutils / manifest.pm < prev    next >
Encoding:
Perl POD Document  |  1996-01-23  |  10.2 KB  |  392 lines
  1. package ExtUtils::Manifest;
  2.  
  3. =head1 NAME
  4.  
  5. ExtUtils::Manifest - utilities to write and check a MANIFEST file
  6.  
  7. =head1 SYNOPSIS
  8.  
  9. C<require ExtUtils::Manifest;>
  10.  
  11. C<ExtUtils::Manifest::mkmanifest;>
  12.  
  13. C<ExtUtils::Manifest::manicheck;>
  14.  
  15. C<ExtUtils::Manifest::filecheck;>
  16.  
  17. C<ExtUtils::Manifest::fullcheck;>
  18.  
  19. C<ExtUtils::Manifest::skipcheck;>
  20.  
  21. C<ExtUtild::Manifest::manifind();>
  22.  
  23. C<ExtUtils::Manifest::maniread($file);>
  24.  
  25. C<ExtUtils::Manifest::manicopy($read,$target,$how);>
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. Mkmanifest() writes all files in and below the current directory to a
  30. file named in the global variable $ExtUtils::Manifest::MANIFEST (which
  31. defaults to C<MANIFEST>) in the current directory. It works similar to
  32.  
  33.     find . -print
  34.  
  35. but in doing so checks each line in an existing C<MANIFEST> file and
  36. includes any comments that are found in the existing C<MANIFEST> file
  37. in the new one. Anything between white space and an end of line within
  38. a C<MANIFEST> file is considered to be a comment. Filenames and
  39. comments are seperated by one or more TAB characters in the
  40. output. All files that match any regular expression in a file
  41. C<MANIFEST.SKIP> (if such a file exists) are ignored.
  42.  
  43. Manicheck() checks if all the files within a C<MANIFEST> in the current
  44. directory really do exist.
  45.  
  46. Filecheck() finds files below the current directory that are not
  47. mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
  48. will be consulted. Any file matching a regular expression in such a
  49. file will not be reported as missing in the C<MANIFEST> file.
  50.  
  51. Fullcheck() does both a manicheck() and a filecheck().
  52.  
  53. Skipcheck() lists all the files that are skipped due to your
  54. C<MANIFEST.SKIP> file.
  55.  
  56. Manifind() retruns a hash reference. The keys of the hash are the
  57. files found below the current directory.
  58.  
  59. Maniread($file) reads a named C<MANIFEST> file (defaults to
  60. C<MANIFEST> in the current directory) and returns a HASH reference
  61. with files being the keys and comments being the values of the HASH.
  62.  
  63. I<Manicopy($read,$target,$how)> copies the files that are the keys in
  64. the HASH I<%$read> to the named target directory. The HASH reference
  65. I<$read> is typically returned by the maniread() function. This
  66. function is useful for producing a directory tree identical to the
  67. intended distribution tree. The third parameter $how can be used to
  68. specify a different methods of "copying". Valid values are C<cp>,
  69. which actually copies the files, C<ln> which creates hard links, and
  70. C<best> which mostly links the files but copies any symbolic link to
  71. make a tree without any symbolic link. Best is the default.
  72.  
  73. =head1 MANIFEST.SKIP
  74.  
  75. The file MANIFEST.SKIP may contain regular expressions of files that
  76. should be ignored by mkmanifest() and filecheck(). The regular
  77. expressions should appear one on each line. A typical example:
  78.  
  79.     \bRCS\b
  80.     ^MANIFEST\.
  81.     ^Makefile$
  82.     ~$
  83.     \.html$
  84.     \.old$
  85.     ^blib/
  86.     ^MakeMaker-\d
  87.  
  88. =head1 EXPORT_OK
  89.  
  90. C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  91. C<&maniread>, and C<&manicopy> are exportable.
  92.  
  93. =head1 GLOBAL VARIABLES
  94.  
  95. C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
  96. results in both a different C<MANIFEST> and a different
  97. C<MANIFEST.SKIP> file. This is useful if you want to maintain
  98. different distributions for different audiences (say a user version
  99. and a developer version including RCS).
  100.  
  101. <$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
  102. all functions act silently.
  103.  
  104. =head1 DIAGNOSTICS
  105.  
  106. All diagnostic output is sent to C<STDERR>.
  107.  
  108. =over
  109.  
  110. =item C<Not in MANIFEST:> I<file>
  111.  
  112. is reported if a file is found, that is missing in the C<MANIFEST>
  113. file which is excluded by a regular expression in the file
  114. C<MANIFEST.SKIP>.
  115.  
  116. =item C<No such file:> I<file>
  117.  
  118. is reported if a file mentioned in a C<MANIFEST> file does not
  119. exist.
  120.  
  121. =item C<MANIFEST:> I<$!>
  122.  
  123. is reported if C<MANIFEST> could not be opened.
  124.  
  125. =item C<Added to MANIFEST:> I<file>
  126.  
  127. is reported by mkmanifest() if $Verbose is set and a file is added
  128. to MANIFEST. $Verbose is set to 1 by default.
  129.  
  130. =back
  131.  
  132. =head1 SEE ALSO
  133.  
  134. L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
  135.  
  136. =head1 AUTHOR
  137.  
  138. Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
  139.  
  140. =cut
  141.  
  142. require Exporter;
  143. @ISA=('Exporter');
  144. @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
  145.           'skipcheck', 'maniread', 'manicopy');
  146.  
  147. use Config;
  148. use File::Find;
  149. use Carp;
  150.  
  151. $Debug = 0;
  152. $Verbose = 1;
  153. $Is_VMS = $Config{'osname'} eq 'VMS';
  154.  
  155. $VERSION = $VERSION = substr(q$Revision: 1.22 $,10,4);
  156.  
  157. $Quiet = 0;
  158.  
  159. $MANIFEST = 'MANIFEST';
  160.  
  161. # Really cool fix from Ilya :)
  162. unless (defined $Config{d_link}) {
  163.     *ln = \&cp;
  164. }
  165.  
  166. sub mkmanifest {
  167.     my $manimiss = 0;
  168.     my $read = maniread() or $manimiss++;
  169.     $read = {} if $manimiss;
  170.     local *M;
  171.     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
  172.     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
  173.     my $matches = _maniskip();
  174.     my $found = manifind();
  175.     my($key,$val,$file,%all);
  176.     my %all = (%$found, %$read);
  177.     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
  178.         if $manimiss; # add new MANIFEST to known file list
  179.     foreach $file (sort keys %all) {
  180.     next if &$matches($file);
  181.     if ($Verbose){
  182.         warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
  183.     }
  184.     my $text = $all{$file};
  185.     ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
  186.     my $tabs = (5 - (length($file)+1)/8);
  187.     $tabs = 1 if $tabs < 1;
  188.     $tabs = 0 unless $text;
  189.     print M $file, "\t" x $tabs, $text, "\n";
  190.     }
  191.     close M;
  192. }
  193.  
  194. sub manifind {
  195.     local $found = {};
  196.     find(sub {return if -d $_;
  197.           (my $name = $File::Find::name) =~ s|./||;
  198.           warn "Debug: diskfile $name\n" if $Debug;
  199.           $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
  200.           $found->{$name} = "";}, ".");
  201.     $found;
  202. }
  203.  
  204. sub fullcheck {
  205.     _manicheck(3);
  206. }
  207.  
  208. sub manicheck {
  209.     return @{(_manicheck(1))[0]};
  210. }
  211.  
  212. sub filecheck {
  213.     return @{(_manicheck(2))[1]};
  214. }
  215.  
  216. sub skipcheck {
  217.     _manicheck(6);
  218. }
  219.  
  220. sub _manicheck {
  221.     my($arg) = @_;
  222.     my $read = maniread();
  223.     my $file;
  224.     my(@missfile,@missentry);
  225.     if ($arg & 1){
  226.     my $found = manifind();
  227.     foreach $file (sort keys %$read){
  228.         warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
  229.         unless ( exists $found->{$file} ) {
  230.         warn "No such file: $file\n" unless $Quiet;
  231.         push @missfile, $file;
  232.         }
  233.     }
  234.     }
  235.     if ($arg & 2){
  236.     $read ||= {};
  237.     my $matches = _maniskip();
  238.     my $found = manifind();
  239.     my $skipwarn = $arg & 4;
  240.     foreach $file (sort keys %$found){
  241.         if (&$matches($file)){
  242.         warn "Skipping $file\n" if $skipwarn;
  243.         next;
  244.         }
  245.         warn "Debug: manicheck checking from disk $file\n" if $Debug;
  246.         unless ( exists $read->{$file} ) {
  247.         warn "Not in $MANIFEST: $file\n" unless $Quiet;
  248.         push @missentry, $file;
  249.         }
  250.     }
  251.     }
  252.     (\@missfile,\@missentry);
  253. }
  254.  
  255. sub maniread {
  256.     my ($mfile) = @_;
  257.     $mfile = $MANIFEST unless defined $mfile;
  258.     my $read = {};
  259.     local *M;
  260.     unless (open M, $mfile){
  261.     warn "$mfile: $!";
  262.     return $read;
  263.     }
  264.     while (<M>){
  265.     chomp;
  266.     if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
  267.     else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
  268.     }
  269.     close M;
  270.     $read;
  271. }
  272.  
  273. # returns an anonymous sub that decides if an argument matches
  274. sub _maniskip {
  275.     my ($mfile) = @_;
  276.     my $matches = sub {0};
  277.     my @skip ;
  278.     my $mfile = "$MANIFEST.SKIP" unless defined $mfile;
  279.     local *M;
  280.     return $matches unless -f $mfile;
  281.     open M, $mfile or return $matches;
  282.     while (<M>){
  283.     chomp;
  284.     next if /^\s*$/;
  285.     push @skip, $_;
  286.     }
  287.     close M;
  288.     my $opts = $Is_VMS ? 'oi ' : 'o ';
  289.     my $sub = "\$matches = "
  290.     . "sub { my(\$arg)=\@_; return 1 if "
  291.     . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
  292.     . " }";
  293.     eval $sub;
  294.     print "Debug: $sub\n" if $Debug;
  295.     $matches;
  296. }
  297.  
  298. sub manicopy {
  299.     my($read,$target,$how)=@_;
  300.     croak "manicopy() called without target argument" unless defined $target;
  301.     $how = 'cp' unless defined $how && $how;
  302.     require File::Path;
  303.     require File::Basename;
  304.     my(%dirs,$file);
  305.     $target = VMS::Filespec::unixify($target) if $Is_VMS;
  306.     umask 0 unless $Is_VMS;
  307.     File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
  308.     foreach $file (keys %$read){
  309.     $file = VMS::Filespec::unixify($file) if $Is_VMS;
  310.     if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
  311.         my $dir = File::Basename::dirname($file);
  312.         $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
  313.         File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
  314.     }
  315.     if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
  316.     else         { cp_if_diff($file, "$target/$file", $how); }
  317.     }
  318. }
  319.  
  320. sub cp_if_diff {
  321.     my($from,$to, $how)=@_;
  322.     -f $from || carp "$0: $from not found";
  323.     my($diff) = 0;
  324.     local(*F,*T);
  325.     open(F,$from) or croak "Can't read $from: $!\n";
  326.     if (open(T,$to)) {
  327.     while (<F>) { $diff++,last if $_ ne <T>; }
  328.     $diff++ unless eof(T);
  329.     close T;
  330.     }
  331.     else { $diff++; }
  332.     close F;
  333.     if ($diff) {
  334.     if (-e $to) {
  335.         unlink($to) or confess "unlink $to: $!";
  336.     }
  337.     &$how($from, $to);
  338.     }
  339. }
  340.  
  341. # Do the comparisons here rather than spawning off another process
  342. sub vms_cp_if_diff {
  343.     my($from,$to) = @_;
  344.     my($diff) = 0;
  345.     local(*F,*T);
  346.     open(F,$from) or croak "Can't read $from: $!\n";
  347.     if (open(T,$to)) {
  348.     while (<F>) { $diff++,last if $_ ne <T>; }
  349.     $diff++ unless eof(T);
  350.     close T;
  351.     }
  352.     else { $diff++; }
  353.     close F;
  354.     if ($diff) {
  355.     system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
  356.         or confess "Copy failed: $!";
  357.     }
  358. }
  359.  
  360. sub cp {
  361.     my ($srcFile, $dstFile) = @_;
  362.     my $buf;
  363.     open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n";
  364.     open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n";
  365.     my ($perm,$access,$mod) = (stat IN)[2,8,9];
  366.     syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192);
  367.     close IN;
  368.     close OUT;
  369.     utime $access, $mod, $dstFile;
  370.     # chmod a+rX-w,go-w
  371.     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
  372. }
  373.  
  374. sub ln {
  375.     my ($srcFile, $dstFile) = @_;
  376.     link($srcFile, $dstFile);
  377.     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
  378.     my $mode= 0444 | (stat)[2] & 0700;
  379.     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
  380. }
  381.  
  382. sub best {
  383.     my ($srcFile, $dstFile) = @_;
  384.     if (-l $srcFile) {
  385.     cp($srcFile, $dstFile);
  386.     } else {
  387.     ln($srcFile, $dstFile);
  388.     }
  389. }
  390.  
  391. 1;
  392.